home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr10 / froff.zip / FIXFORT.FOR < prev    next >
Text File  |  1992-10-30  |  7KB  |  260 lines
  1. C     RENBR(FIXFORT/CONVERT COLUMN 1 IN FORTRAN LISTING FILES)
  2. C
  3. C     BY DONALD E. BARTH
  4. C
  5. C     THIS PROGRAM WILL CONVERT THE FOLLOWING CHARACTERS
  6. C     IN COLUMN 1 OF FORTRAN LISTING FILES:
  7. C
  8. C     1 TO NEW PAGE
  9. C     0 TO DOUBLE SPACING
  10. C     + TO OVERPRINT PREVIOUS LINE
  11. C     * OR SPACE TO SINGLE SPACING
  12. C
  13. C     THE ASTERISK IS USED ON DEC COMPUTERS TO CONTINUE PRINTING
  14. C     ACROSS THE FOLDS OF FAN FOLD PAPER WITHOUT SKIPPING LINES.
  15. C     ON THE NORMAL PAGE, IT ACTS LIKE A SPACE CARRIAGE CONTROL
  16. C     CHARACTER. IN THIS PROGRAM THE ASTERISK IS TREATED LIKE A
  17. C     SPACE.
  18. C
  19.       CHARACTER*1 CHAR,LTRLF,LTRFF,LTRCR,LTRNOW
  20.       CHARACTER*80 FILINP,FILOUT
  21.       DATA ITTY,JTTY,IDISK,JDISK/0,0,1,2/
  22. C
  23. C     IDENTIFY THIS PROGRAM
  24.       WRITE(JTTY,1)
  25.     1 FORMAT(' FIXFORT'/
  26.      1' Converts characters in column 1 of Fortran files',
  27.      2' to form feeds and line feeds')
  28. C
  29. C     OPEN NEXT INPUT FILE
  30.     2 WRITE(JTTY,3)
  31.     3 FORMAT(' Input file? ',\)
  32.       READ(ITTY,4)FILINP
  33.     4 FORMAT(1A80)
  34.       IF(FILINP.EQ.' ')GO TO 6
  35.       OPEN(UNIT=IDISK,FILE=FILINP,STATUS='OLD',IOSTAT=ICHECK,
  36.      1 FORM='BINARY')
  37.       IF(ICHECK.EQ.0)GO TO 8
  38.       WRITE(JTTY,5)
  39.     5 FORMAT(' Cannot open input file')
  40.       GO TO 2
  41.     6 WRITE(JTTY,7)
  42.     7 FORMAT(' Name of input file must be specified')
  43.       GO TO 2
  44.     8 CONTINUE
  45. C
  46. C     OPEN OUTPUT FILE
  47.     9 WRITE(JTTY,10)
  48.    10 FORMAT(' Output file? ',\)
  49.       READ(ITTY,11)FILOUT
  50.    11 FORMAT(1A80)
  51.       IF(FILOUT.EQ.' ')GO TO 15
  52.       OPEN(UNIT=JDISK,FILE=FILOUT,STATUS='OLD',IOSTAT=ICHECK)
  53.       IF(ICHECK.NE.0)GO TO 17
  54.       CLOSE(UNIT=JDISK)
  55.    12 WRITE(JTTY,13)
  56.    13 FORMAT(' File already exists. Replace it? ',\)
  57.       READ(ITTY,14)LTRNOW
  58.    14 FORMAT(1A1)
  59.       IF(LTRNOW.EQ.'Y')GO TO 17
  60.       IF(LTRNOW.EQ.'y')GO TO 17
  61.       IF(LTRNOW.EQ.'N')GO TO 9
  62.       IF(LTRNOW.EQ.'n')GO TO 9
  63.       GO TO 12
  64.    15 WRITE(JTTY,16)
  65.    16 FORMAT(' Name of output file must be specified')
  66.       GO TO 9
  67.    17 OPEN(UNIT=JDISK,FILE=FILOUT,STATUS='NEW',IOSTAT=ICHECK,
  68.      1 FORM='BINARY')
  69.       IF(ICHECK.EQ.0)GO TO 19
  70.       WRITE(JTTY,18)
  71.    18 FORMAT(' Cannot open output file')
  72.       GO TO 9
  73.    19 CONTINUE
  74. C
  75. C     INITIALIZE
  76. C
  77. C     IONLIN = LENGTH OF LINE NOW BEING OUTPUT
  78. C     ISTACK = 0, NO LF NEEDS TO BE OUTPUT, =1 OUTPUT ONE LF
  79. C     KNTINP = NUMBER OF CHARACTERS READ FROM INPUT FILE
  80. C     KNTLIN = NUMBER OF NON-EMPTY OUTPUT LINES
  81. C     KNTOUT = NUMBER OF CHARACTERS WRITTEN TO OUTPUT FILE
  82. C     MSTLIN = LENGTH OF LONGEST OUTPUT LINE
  83. C     NEWLIN = 0 IF OUTPUTTING A LINE, = 1 IF READY TO START NEW LINE
  84. C
  85.       IONLIN=0
  86.       ISTACK=0
  87.       KNTINP=0
  88.       KNTLIN=0
  89.       KNTOUT=0
  90.       MSTLIN=0
  91.       NEWLIN=-1
  92. C
  93. C     END OF LINE CHARACTERS
  94. C
  95. C     LTRCR,LTRLF,LTRFF = THE CHARACTERS CR, LF, FF
  96. C     INPCR,INPLF,INPFF = NUMBERS OF INPUT CR, LF, FF
  97. C     KNTCR,KNTLF,KNTFF = NUMBERS OF OUTPUT CR, LF, FF
  98. C
  99.       LTRLF=CHAR(10)
  100.       LTRFF=CHAR(12)
  101.       LTRCR=CHAR(13)
  102.       INPCR=0
  103.       INPLF=0
  104.       INPFF=0
  105.       KNTCR=0
  106.       KNTLF=0
  107.       KNTFF=0
  108. C
  109. C     COPY THE FILE, CONVERTING START OF EACH NEW LINE AS FOUND
  110.    20 READ(IDISK,END=31)LTRNOW
  111.       KNTINP=KNTINP+1
  112.       KODE=ICHAR(LTRNOW)
  113.       IF(KODE.EQ.0)GO TO 20
  114. C
  115. C     LOOK FOR END OF LINE CHARS: LF=10, FF=12, CR=13
  116.       IF(KODE.EQ.10)GO TO 25
  117.       IF(KODE.EQ.12)GO TO 27
  118.       IF(KODE.EQ.13)GO TO 29
  119.       IF(NEWLIN.EQ.0)GO TO 24
  120.       NEWLIN=0
  121. C
  122. C     START OF A NEW LINE
  123.       IF(ISTACK.EQ.0)GO TO 21
  124.       IF(LTRNOW.EQ.'+')ISTACK=0
  125.       IF(LTRNOW.EQ.'1')ISTACK=0
  126.       IF(ISTACK.EQ.0)GO TO 21
  127.       ISTACK=0
  128.       WRITE(JDISK)LTRLF
  129.       KNTOUT=KNTOUT+1
  130.       KNTLF=KNTLF+1
  131.    21 CONTINUE
  132. C
  133. C     INITIAL ONE INDICATES FORM FEED
  134.       IF(LTRNOW.NE.'1')GO TO 22
  135.       WRITE(JDISK)LTRFF
  136.       KNTOUT=KNTOUT+1
  137.       KNTFF=KNTFF+1
  138.    22 CONTINUE
  139. C
  140. C     INITIAL ZERO INDICATES DOUBLE LINE SPACING
  141.       IF(LTRNOW.NE.'0')GO TO 23
  142.       WRITE(JDISK)LTRLF
  143.       KNTOUT=KNTOUT+1
  144.       KNTLF=KNTLF+1
  145.    23 CONTINUE
  146. C
  147. C     INITIALIZE TO START OF LINE
  148.       KNTLIN=KNTLIN+1
  149.       CALL RUNLIN(KNTLIN,ITTY,JTTY)
  150.       IONLIN=0
  151.       NEWLIN=0
  152. C
  153. C     DECIDE IF HAVE TO SHOW PRINTING CHARACTER
  154.       IPRINT=1
  155.       IF(LTRNOW.EQ.' ')IPRINT=0
  156.       IF(LTRNOW.EQ.'*')IPRINT=0
  157.       IF(LTRNOW.EQ.'1')IPRINT=0
  158.       IF(LTRNOW.EQ.'0')IPRINT=0
  159.       IF(LTRNOW.EQ.'+')IPRINT=0
  160.       IF(IPRINT.EQ.0)GO TO 20
  161.       GO TO 24
  162. C
  163. C     OUTPUT THE SINGLE NEW CHARACTER
  164.    24 KNTOUT=KNTOUT+1
  165.       IONLIN=IONLIN+1
  166.       WRITE(JDISK)LTRNOW
  167.       IF(MSTLIN.LT.IONLIN)MSTLIN=IONLIN
  168.       GO TO 20
  169. C
  170. C     LINE FEED (10)
  171.    25 INPLF=INPLF+1
  172.       IF(ISTACK.EQ.0)GO TO 26
  173.       WRITE(JDISK)LTRLF
  174.       KNTOUT=KNTOUT+1
  175.       KNTLF=KNTLF+1
  176.       ISTACK=0
  177.    26 CONTINUE
  178.       ISTACK=1
  179.       NEWLIN=1
  180.       GO TO 20
  181. C
  182. C     FORM FEED (12)
  183.    27 INPFF=INPFF+1
  184.       IF(ISTACK.EQ.0)GO TO 28
  185.       WRITE(JDISK)LTRLF
  186.       KNTOUT=KNTOUT+1
  187.       KNTLF=KNTLF+1
  188.       ISTACK=0
  189.    28 CONTINUE
  190.       WRITE(JDISK)LTRFF
  191.       KNTOUT=KNTOUT+1
  192.       KNTFF=KNTFF+1
  193.       NEWLIN=1
  194.       GO TO 20
  195. C
  196. C     CARRIAGE RETURN (13)
  197.    29 INPCR=INPCR+1
  198.       IF(ISTACK.EQ.0)GO TO 30
  199.       WRITE(JDISK)LTRLF
  200.       KNTOUT=KNTOUT+1
  201.       KNTLF=KNTLF+1
  202.       ISTACK=0
  203.    30 CONTINUE
  204.       WRITE(JDISK)LTRCR
  205.       KNTOUT=KNTOUT+1
  206.       KNTCR=KNTCR+1
  207.       NEWLIN=1
  208.       GO TO 20
  209. C
  210. C     INSERT LINE FEED AT END OF FILE
  211.    31 IF(ISTACK.EQ.0)GO TO 32
  212.       WRITE(JDISK)LTRLF
  213.       KNTOUT=KNTOUT+1
  214.       KNTLF=KNTLF+1
  215.       ISTACK=0
  216.    32 CONTINUE
  217. C
  218. C     REPORT STATISTICS
  219.       WRITE(JTTY,33)KNTINP
  220.       WRITE(JTTY,34)KNTOUT
  221.       WRITE(JTTY,35)MSTLIN
  222.       WRITE(JTTY,36)KNTLIN
  223.       WRITE(JTTY,37)INPLF,KNTLF
  224.       WRITE(JTTY,38)INPFF,KNTFF
  225.       WRITE(JTTY,39)INPCR,KNTCR
  226.    33 FORMAT(' ',1I10,' bytes read')
  227.    34 FORMAT(' ',1I10,' bytes written')
  228.    35 FORMAT(' ',1I10,' length of longest output line')
  229.    36 FORMAT(' ',1I10,' non-empty lines')
  230.    37 FORMAT(' ',1I10,'/',1I10,' line feeds read/written')
  231.    38 FORMAT(' ',1I10,'/',1I10,' form feeds read/written')
  232.    39 FORMAT(' ',1I10,'/',1I10,' returns read/written')
  233. C
  234. C     ALL DONE
  235.       END
  236.       SUBROUTINE RUNLIN(LINE,ITTY,JTTY)
  237.       IF(LINE.EQ.1)WRITE(JTTY,1)LINE
  238.       IF(LINE.GT.        1.AND.LINE.LT.        10)WRITE(JTTY,2)LINE
  239.       IF(LINE.GE.       10.AND.LINE.LT.       100)WRITE(JTTY,3)LINE
  240.       IF(LINE.GE.      100.AND.LINE.LT.      1000)WRITE(JTTY,4)LINE
  241.       IF(LINE.GE.     1000.AND.LINE.LT.     10000)WRITE(JTTY,5)LINE
  242.       IF(LINE.GE.    10000.AND.LINE.LT.    100000)WRITE(JTTY,6)LINE
  243.       IF(LINE.GE.   100000.AND.LINE.LT.   1000000)WRITE(JTTY,7)LINE
  244.       IF(LINE.GE.  1000000.AND.LINE.LT.  10000000)WRITE(JTTY,8)LINE
  245.       IF(LINE.GE. 10000000.AND.LINE.LT. 100000000)WRITE(JTTY,9)LINE
  246.       IF(LINE.GE.100000000.AND.LINE.LT.1000000000)WRITE(JTTY,10)LINE
  247. C                123456789             1234567890
  248.     1 FORMAT(' ',1I1)
  249.     2 FORMAT('+',1I1)
  250.     3 FORMAT('+',1I2)
  251.     4 FORMAT('+',1I3)
  252.     5 FORMAT('+',1I4)
  253.     6 FORMAT('+',1I5)
  254.     7 FORMAT('+',1I6)
  255.     8 FORMAT('+',1I7)
  256.     9 FORMAT('+',1I8)
  257.    10 FORMAT('+',1I9)
  258.       RETURN
  259.       END
  260.